#include "interpreter.h"
#include "builtin.h"
#include "stdlib.h"
#include "assert.h"
#include "string.h"
#include <setjmp.h>
#include <gc/gc.h>

#include "string-buffer.h"
#include "scope.h"
#include "symbol-table.h"

/*
  INVESTIGATE:
  - recurse is broken! (confirm! why did I not give a test case?!)
    - how is it broken?
  PRIORITIES:
  - Documentary headers for all functions...:)
  - Standardise builtin argument evaluation
  - Test arithmetic + comparisons
    - Plug holes in comparisons
    - Type conversion
      - lists/strings
      - characters/strings?
  - Package cmew up to be usable

  TODO:
  - Clean up helper functions
  - Sort out file structure (headers particularly)
  - Comment copiously
*/

unsigned long evaluation_count = 0;
unsigned long value_evaluation_count = 0;

/*
  WORK NEEDED:
  Deprecate in favour of throw_exception
*/
void exception_at(handler_t *exception, value_t *value, char *tag_string, char *value_string)
{
  exception->tag = make_tag(to_unicode(tag_string));

  exception->value = (value_t*)make_string(to_unicode(value_string));

  longjmp(exception->jump, 1);
}

// Should char *be const?
void throw_exception(handler_t *exception, char *tag_string, char *value_string)
{
  exception->tag = make_tag(to_unicode(tag_string));
  exception->value = (value_t*)make_string(to_unicode(value_string));
  longjmp(exception->jump, 1);
}

name_t *make_name(UChar *string);

void register_builtin(scope_t *scope,
  char *name_string, value_t *(*function)(generic_list_t*,scope_t*,int,handler_t*),
  int arity, int varargs)
{
  UChar *u_name = to_unicode(name_string);
  name_t *name = make_name(u_name);
  builtin_t *builtin = make_builtin(name, function, arity, varargs);
  bind(scope,name,(value_t*)builtin);
}

// Update call_closure to use some variation upon this theme?
inline value_t *tail_call(scope_t *scope, call_t *call, int tail, handler_t *handler)
{
  trampoline_t *trampoline;

	if(tail)
	{
    trampoline = make_trampoline(call,scope);
  }
  else
  {
    trampoline = (trampoline_t*)evaluate_call(scope,call,1,handler);
    while(has_type(trampoline, type_trampoline))
    {
      call = trampoline->call;
      scope = trampoline->closure;
      trampoline = (trampoline_t*)evaluate_call(scope,call,1,handler);
    }
  }

  return (value_t*)trampoline;
}

value_t *run_function(scope_t *scope, function_t *function, handler_t *handler)
{
  value_t *result;

  iterator_t *calls = get_iterator(function->body);
  call_t *call;

  result = (value_t*)make_tag(to_unicode("none"));

  for( call = (call_t*)iterate_first(calls);
        iterate_is_valid(calls);
        call = (call_t*)iterate_next(calls) )
  {
    if(call->arguments)
    {
      result = evaluate_call(scope,call,0,handler);
    }
    else
    {
      result = evaluate_item(scope,call->head,handler);
    }
  }

  return result;
}

/*Don't create new scopes unless/until the closure requires them */

value_t *call_closure(closure_t *closure, generic_list_t *arguments, int tail, scope_t **save, handler_t *handler)
{  
  function_t *function = closure->function;
  scope_t *scope = closure->scope;
  /*Check arity - share this with builtins? */
  int num_args = arguments ? arguments->length : 0;
  if(!has_arity((value_t*)closure,num_args))
    exception_at(handler,(value_t*)closure,"arity","Wrong number of arguments");
  
  scope_t *bound_arguments = make_scope(scope, function->arguments, arguments, function->tail);

  if(function->recursive)
  {
    bind(bound_arguments,make_name(to_unicode("recurse")),(value_t*)closure);
  }

  if(save)
  {
    *save = bound_arguments;
  }

  value_t *result = 0;

  call_t *call;

  iterator_t *calls = get_iterator(function->body);

  for( call = (call_t*)iterate_first(calls);
        !iterate_at_end(calls);
        call = (call_t*)iterate_next(calls) )
  {
    int arity = 0;

    if(call->arguments)
      arity = (call->arguments)->length;

    if(arity)
      result = evaluate_call(bound_arguments,call,0,handler);
    else
      result = evaluate_item(bound_arguments,call->head,handler);
  }

  // No empty function bodies?
  //assert(current);
 
  if(!iterate_is_valid(calls))
  {
    exception_at(handler,(value_t*)function,"syntax", "empty function body");
  }
 
  int arity = 0;
  if(call->arguments)
    arity = (call->arguments)->length;

  if(0 != arity)
  { 
    result = tail_call(bound_arguments,call,tail,handler);
  }
  else if(has_type(call->head,type_call))
  {
    result = tail_call(bound_arguments,(call_t*)call->head,tail,handler);
  }
  else
  {
    result = evaluate_item(bound_arguments, (value_t*)((call_t*)call->head), handler);
  }

  return result;
}

generic_list_t *evaluate_list_append(
  scope_t *scope, generic_list_t *items, int *is_string, handler_t *handler)
{
  generic_list_t *concrete = make_generic_list(NULL);

  *is_string = 1;

  value_t *item, *value;
  iterator_t *append_items = get_iterator(items);

  for(item = iterate_first(append_items);
      iterate_is_valid(append_items);
      item = iterate_next(append_items))
  {
    value = evaluate_item(scope, item, handler);    
    if(has_type(value, type_string))
    {
      generic_list_add(concrete, value);
    }
    else if(has_type(value, type_list))
    {
      generic_list_add(concrete, value);
      *is_string = 0;
      break;
    }
    else
    {
      exception_at(handler, value, "type", "Attempt to append non-list");
    }
  }

  if(!iterate_is_valid(append_items))
    return concrete;

  while( (item = iterate_next(append_items))
          && iterate_is_valid(append_items) )
  {
    value = evaluate_item(scope, item, handler);
    generic_list_add(concrete, value);
  }

  return concrete;
}

generic_list_t *evaluate_list_type(
  scope_t *scope, generic_list_t *items, type_t type, int *type_holds, handler_t *handler)
{
  generic_list_t *concrete = make_generic_list(NULL);

  *type_holds = 1;

  iterator_t *list_items = get_iterator(items);
  value_t *item, *value;

  for(item = iterate_first(list_items);
      iterate_is_valid(list_items);
      item = iterate_next(list_items))
  {
    value = evaluate_item(scope, item, handler);
    generic_list_add(concrete, value);
    if(!has_type(value, type))
    {
      *type_holds = 0;
      break;
    }
  }

  if(!iterate_is_valid(list_items))
    return concrete;

  while( (item = iterate_next(list_items))
          && iterate_is_valid(list_items) )
  {
    value = evaluate_item(scope, item, handler);
    generic_list_add(concrete, value);
  }

  return concrete;
}

generic_list_t *evaluate_list(scope_t *scope, generic_list_t *arguments,handler_t *handler)
{
  size_t number_of_arguments = arguments->length;

  void *list_buffer = GC_MALLOC(sizeof(generic_list_t)
                                + (number_of_arguments * sizeof(list_entry_t)));
  
  generic_list_t *concrete = list_buffer; // make_generic_list(NULL);

  concrete->type = type_generic_list;
  concrete->length = number_of_arguments;

  list_entry_t *previous;
  list_entry_t *current = previous = (list_entry_t*)(concrete + 1);
  concrete->first = current;

  iterator_t stack_allocated;
  iterator_t *list_items = &stack_allocated; //get_iterator(arguments);
  value_t *item, *value;

  int i = 0;

  for(item = new_iterate_first(list_items, arguments);
        iterate_is_valid(list_items); //i < number_of_arguments;
        /*(++i) &&*/ (item = iterate_next(list_items)))
  {
    current->head = evaluate_item(scope, item, handler);
    current->tail = (current + 1);
    previous = current++;
  }

  previous->tail = 0;
  concrete->last = previous;
/*
  for(item = iterate_first(list_items);
      iterate_is_valid(list_items);
      item = iterate_next(list_items))
  {
    current->
    value = evaluate_item(scope, item, handler);
    generic_list_add(concrete, value);
  }
*/
  return concrete;  
}

value_t *__evaluate_tagged_pointer(scope_t *scope, value_t *item, handler_t *handler)
{
  value_t *result;

  // Constructor type - evaluate
  switch(0x6F & (uintptr_t)item)
  {
    case 0x1:
      result = lookup_flat_symbol(scope, (name_t*)item, handler);
      break;
    default:
      assert(0);
  }

  return result;
}

value_t *evaluate_tagged_pointer(scope_t *scope, value_t *item, handler_t *handler)
{
  // Value type - return
  if(((uintptr_t)item & 0xFF) < 0x80)
    return item;

  return __evaluate_tagged_pointer(scope, item, handler);
}

int is_value_type(value_t *item)
{
  if(is_tagged_pointer(item))
  {
    return (((uintptr_t)item & 0xFF) < 0x80);
  }
  else
  {
    return (get_type(item) < constructor_type);
  }
}

value_t *evaluate_item(scope_t *scope, value_t *item, handler_t *handler)
{
  generic_list_t *concrete;
  value_t *evaluated = 0;
  value_t *result = 0;
  int holds;

  // Nothing to evaluate
  if(is_value_type(item))
    return item;

  //evaluation_count++;

  if(is_tagged_pointer(item))
  {
    // Bypass the value type check already performed above
    return __evaluate_tagged_pointer(scope, item, handler);
  }

  switch(get_type(item))
  {
    case type_function:
      result = (value_t*)make_closure(scope, (function_t*)item);
      break;
    case type_call:
      result = evaluate_call(scope,(call_t*)item, 0, handler);
      break;
    case type_name:
      result = lookup(scope, (name_t*)item, 0, handler);
      break;
    case type_list:
    {
      if(item->list.concrete || !item->list.items)
      {
        result = item;
        break;
      }
      int is_string = 1;
      concrete =
        evaluate_list_type(scope,((list_t*)item)->items,type_character,&is_string, handler);
      
      if(is_string)
      {
        string_buffer_t *as_string = make_string_buffer(256);
        iterator_t *list_items = get_iterator(concrete);
        character_t *item;

        for(item = iterate_first(list_items);
              iterate_is_valid(list_items);
              item = iterate_next(list_items))
        {
          string_buffer_append_character(as_string, item->value);
        }
        evaluated = (value_t*)make_string(string_buffer_finalize(as_string));
      }
      else
      {
        evaluated = (value_t*)make_list(concrete);
      }
      evaluated->list.concrete = 1;
      result = evaluated;
      break;
    }
    case type_append:
    {
      generic_list_t *accumulator = make_generic_list(NULL);
      int is_string = 1;
      generic_list_t *concrete =
        evaluate_list_append(scope,((append_t*)item)->lists,&is_string, handler);
      
      if(is_string)
      {
        string_buffer_t *as_string = make_string_buffer(256);
        iterator_t *append_items = get_iterator(concrete);
        string_t *item;
        
        for(item = iterate_first(append_items);
            iterate_is_valid(append_items);
            item = iterate_next(append_items))
        {
          string_buffer_append(as_string, item->value);
        }
        evaluated = (value_t*)make_string(string_buffer_finalize(as_string));
      }
      else
      {
        iterator_t *append_items = get_iterator(concrete);
        list_t *item;
        
        for(item = iterate_first(append_items);
            iterate_is_valid(append_items);
            item = iterate_next(append_items))
        {
          if(has_type(item, type_string))
          {
            item = string_to_list((string_t*)item);
          }
          else if(!has_type(item, type_list))
          {
            exception_at(handler, (value_t*)item, "type", "Cannot append non-lists");
          }
          accumulator = generic_list_append(accumulator, item->items);
        }
        evaluated = (value_t*)make_list(accumulator);
      }
      result = evaluated;
      break;
    }
    case type_interpolate:
    {
      // We should get a basic size from the known string lengths...
      string_buffer_t *interpolate_string = make_string_buffer(256);
      generic_list_t *concrete = evaluate_list(scope,((interpolate_t*)item)->values, handler);
      iterator_t *interpolate_items = get_iterator(concrete);
      value_t *item;

      for(item = iterate_first(interpolate_items);
          iterate_is_valid(interpolate_items);
          item = iterate_next(interpolate_items))
      {
        UChar *as_string = has_type(item, type_string) ? (item->string.value) : show_value(item);
        if(has_type(item, type_string))
        {
          string_buffer_append(interpolate_string, (item->string.value));
        }
        else
        {
          string_buffer_append(interpolate_string, show_value(item));
        }
      }

      result = (value_t*)make_string(string_buffer_finalize(interpolate_string));
      break;
    }
    /*
    case type_builtin:
    case type_scope:
    case type_closure:
    case type_float:
    case type_integer:
    case type_character:
    case type_string:
    case type_tag:
      result = item;
      //value_evaluation_count++;
      break;*/
    default:
      assert(0);
  }

  // Will this survive threading?
  //if(result)
    //result->generic.data = item->generic.data;
  return result;
}

// How do we handle huge cycles?

void push_call_stack(handler_t*handler, call_t*call)
{
  assert(has_type(call, type_call));
  generic_list_insert(handler->stack,call);
}

call_t *pop_call_stack(handler_t*handler)
{
  call_t *result = (call_t*)generic_list_remove(handler->stack);
  assert(has_type(result, type_call));
  return result;
}

/*
 Sort it out!
*/

value_t *evaluate_call(scope_t *scope, call_t *call, int tail, handler_t *handler)
{
  value_t *head = call->head;
  generic_list_t *arguments = call->arguments;

  push_call_stack(handler,call);

  head = evaluate_item(scope,head,handler);
 
  generic_list_t *concrete_arguments = 0;
  
  if(!has_type(head,type_builtin) && arguments)
  {
    concrete_arguments = evaluate_list(scope,arguments,handler);
    
  }
  
  int number_of_arguments = arguments ? arguments->length : 0;

  value_t *result;
  switch(get_type(head))
  {
    case type_closure:
      result = call_closure((closure_t*)head,concrete_arguments,tail,NULL, handler);
      break;
    case type_builtin:
    {
      if(!has_arity((value_t*)head,number_of_arguments))
      {
          if(has_variable_arity(head))
          {
            exception_at(handler,head,"arity","Too few arguments");
          }
          else
          {
            exception_at(handler,head,"arity","Wrong number of arguments");
          }
      }
      result = head->builtin.function(arguments,scope,tail,handler);
      break;
    }
    case type_tag:
    {
      // Check arity!
      if(1 != number_of_arguments)
      {
        exception_at(handler, head, "arity","Tag takes a single argument");
      }
      /*
      Tag operations are mutating, so we need a new copy for now.
      Work is needed to identify whether/where this is truly necessary.
      */
      value_t *clone = GC_MALLOC(sizeof(value_t));
      memcpy(clone,concrete_arguments->first->head,sizeof(value_t));
      // Do we need a generic value cloning method?
      clone->generic.tags = generic_list_copy(clone->generic.tags);
      if(clone->generic.tags)
      {
        generic_list_insert(clone->generic.tags, head);
      }
      else
      {
        clone->generic.tags = make_generic_list(head);
      }
      result = clone;
      break;
    }
    default:
      exception_at(handler,head,"type","Non-closure call heads unimplemented");
  }
  pop_call_stack(handler);
  return result;
}

char *from_unicode(UChar *u_string)
{
  UErrorCode error = 0;
  UConverter *converter = ucnv_open(NULL,&error);
  int32_t char_size = u_strlen(u_string);
  char *char_string = GC_MALLOC((char_size + 1)*sizeof(char));
  ucnv_fromUChars(converter,char_string, char_size, u_string, char_size, &error);
  assert(!U_FAILURE(error));
  ucnv_close(converter);
  return char_string;
}

UChar *to_unicode(char *char_string)
{
  UErrorCode error = 0;
  UConverter *converter = ucnv_openU(NULL,&error);
  ucnv_resetToUnicode(converter);
  int32_t char_size = strlen(char_string);
  UChar *u_string = GC_MALLOC((char_size + 1) * sizeof(UChar));
  ucnv_toUChars(converter,u_string, char_size, char_string, char_size, &error);
  assert(!U_FAILURE(error));
  ucnv_close(converter);
  return u_string;
}

// This should really take a call_t*.
UChar *show_top_level_call(value_t *value)
{
  call_t *call = &(value->call);

  // Need a "default sensible string buffer size" defined somewhere
  // - base this on empirical data ;-) (finalized size - initial size?)
  string_buffer_t *call_string = make_string_buffer(1024);
  string_buffer_append(call_string, show_value(call->head));
  
  if(call->arguments)
  {
    // Unify arguments/parameters terminology!
    iterator_t *call_parameters = get_iterator(call->arguments);
    value_t *current;

    for(current = iterate_first(call_parameters);
          iterate_is_valid(call_parameters);
          current = iterate_next(call_parameters))
    {
      string_buffer_append_character(call_string, ' ');
      string_buffer_append(call_string, show_value(current));
    }
  }

  return string_buffer_finalize(call_string);
}

/*
NOTE:
- Calls to string_buffer_append_character currently assume we're
  building with ASCII or UTF-16. Bad!
- If a != b, then (show a) should != (show b). Not currently true
  - Need to differentiate between closures of same arity and scopes
*/

void display_value(string_buffer_t *display_buffer, value_t *value)
{
  /*Show attached tags? */
  UChar *string_buffer;
  int i;
  switch(get_type(value))
  {
    case type_string:
    {
      string_buffer_append_character(display_buffer,'"');
      string_buffer_append(display_buffer, value->string.value);
      string_buffer_append_character(display_buffer,'"');
      break;
    }
    case type_character:
    {
      string_buffer_append_character(display_buffer,'\'');
      string_buffer_append_character(display_buffer,value->character.value);
      string_buffer_append_character(display_buffer,'\'');
      break;
    }
    case type_tag:
    {
      UChar *tag_string = get_identifier_string(tag_get_value(value));
      string_buffer_append_character(display_buffer,'.');
      string_buffer_append(display_buffer,tag_string);
      break;
    }
    case type_integer:
    {
      string_buffer_append(display_buffer,(UChar*)to_unicode(mpz_get_str(NULL,10,value->integer.value)));
      break;
    }
    case type_float:
    {
      mp_exp_t exponent;
      int offset = 0;
      UChar *float_string = to_unicode(mpf_get_str(NULL,&exponent,10,0,value->floatt.value));
      
      size_t string_length = u_strlen(float_string);
      
      if (0 == (int)string_length)
      {
        string_buffer_append(display_buffer,(UChar*)to_unicode("0.0"));
        break;
      }
      
      if (L'-' == float_string[0])
      {
        offset = 1;
        string_buffer_append_character(display_buffer,L'-');
      }

      if (exponent < 1)
      {
        string_buffer_append_character(display_buffer,'0');
      }
      else
      {
        string_buffer_append_n(display_buffer,float_string+offset,exponent);
        for (i = 0; i < (exponent - (int)string_length + offset); i++)
        {
          string_buffer_append_character(display_buffer,'0');
        }
      }
        
      string_buffer_append_character(display_buffer,'.');
        
      if(exponent >= (int)string_length)
      {
        string_buffer_append_character(display_buffer,'0');
      }
      else
      {
        if (exponent < 0)
        {
          for (i = exponent - offset; i < 0; i++)
          {
            string_buffer_append_character(display_buffer,'0');
          }
          string_buffer_append(display_buffer, float_string+offset);
        }
        else
        {
          string_buffer_append(display_buffer, float_string+offset+exponent);
        }
      }
      
      break;
    }
    case type_list:
    {
      if(0 == value->list.items)
      {
        string_buffer_append(display_buffer,to_unicode("[]"));
        break;
      }
 
      string_buffer_append_character(display_buffer,'[');


      iterator_t *items = get_iterator(value->list.items);
      value_t *current = iterate_first(items);

      // List is non-empty
      if(iterate_is_valid(items))
      {

        // Display the first item, avoiding spacing if
        // it's the only one in the list
        display_value(display_buffer, current);
 
        // Iterate through the remaining list items,
        // displaying them separated by spaces
       
        for(current = iterate_next(items);
              iterate_is_valid(items);
              current = iterate_next(items))
        {
          string_buffer_append_character(display_buffer,' ');
          display_value(display_buffer, current);
        }
      }

      string_buffer_append_character(display_buffer,']');
      break;
    }
    case type_append:
    {
      string_buffer_append(display_buffer,to_unicode("[ ~ "));

      value_t *current;
      iterator_t *items = get_iterator(value->append.lists);

        // Iterate through list items,
        // displaying them separated by spaces
        
      for(current = iterate_first(items);
            iterate_is_valid(items);
            current = iterate_next(items))
      {
        display_value(display_buffer, current);
        string_buffer_append_character(display_buffer, ' ');
      }

      string_buffer_append_character(display_buffer,']');
      break;
    }
    case type_function: // For backtraces - we won't have a closure
    {
      if(is_recursive(value))
      {
        string_buffer_append_character(display_buffer,'@');
      }

      string_buffer_append_character(display_buffer,'{');

      int has_arguments = 0;

      if(get_arity(value))
      {
        iterator_t *parameters = get_iterator(value->function.arguments);
        value_t *current;
        for(current = iterate_first(parameters);
            iterate_is_valid(parameters);
            current = iterate_next(parameters))
        {
          string_buffer_append_character(display_buffer,' ');
          display_value(display_buffer,current);
        }
        has_arguments = 1;
      }

      if(has_variable_arity(value))
      {
        string_buffer_append(display_buffer, to_unicode(" ~ "));
        display_value(display_buffer,(value_t*)value->function.tail);
        has_arguments = 1;
      }

      if(has_arguments)
      {
        string_buffer_append(display_buffer, to_unicode(" :"));
      }

      string_buffer_append(display_buffer,to_unicode(" ... }"));

      break;
    }
    case type_closure:
    case type_builtin:
    {
      int arity = get_arity(value);
      string_buffer_append(display_buffer,to_unicode("function/"));
      
      UChar *digit_string = GC_MALLOC(21*sizeof(UChar));

      u_sprintf(digit_string, "%d", arity);
      string_buffer_append(display_buffer,digit_string);

      if(has_variable_arity(value))
        string_buffer_append_character(display_buffer, '+');
      break;
    }
    case type_scope:
    {
      string_buffer_append(display_buffer, to_unicode("<scope>"));
      break;
    }
    case type_reference:
    {
      // Argh, hard-coded assumptions!
      UChar *pointer_string = GC_MALLOC(22*sizeof(UChar));
      
      // Assuming we're compiling in ASCII or UTF-{8,16}, argh!
      string_buffer_append_character(display_buffer, '<');
      u_sprintf(pointer_string, "<0x%p:", value);
      string_buffer_append(display_buffer, pointer_string);

      if(has_type(value->reference.value,type_reference))
      {
        u_sprintf(pointer_string, "0x%p", value->reference.value);
        string_buffer_append(display_buffer, pointer_string);
      }
      else
      {
        display_value(display_buffer, value->reference.value);
      }
      string_buffer_append_character(display_buffer, '>');
      break;
    }
    case type_call:
    {
      string_buffer_append_character(display_buffer, '(');
      display_value(display_buffer, value->call.head);
      
      if(value->call.arguments)
      {
        value_t *current;
        iterator_t *arguments = get_iterator(value->call.arguments);

        for(current = iterate_first(arguments);
              iterate_is_valid(arguments);
              current = iterate_next(arguments))
        {
          string_buffer_append_character(display_buffer, ' ');
          display_value(display_buffer, current);
        }
      }

      string_buffer_append_character(display_buffer, ')');
      break;
    }
    case type_name:
    {
      if(is_tagged_pointer(value))
      {
        string_buffer_append(display_buffer, get_identifier_string(name_get_value(value)));
      }
      else
      {
        string_buffer_append(display_buffer, get_identifier_string(value->name.head));
        if(value->name.parts)
        {
          //UChar *current;
          symbol_t current;
          iterator_t *parts = get_iterator(value->name.parts);
          for(current = (symbol_t)iterate_first(parts);
                iterate_is_valid(parts);
                current = (symbol_t)iterate_next(parts))
          {
            string_buffer_append_character(display_buffer,'.');
            string_buffer_append(display_buffer,get_identifier_string(current));
          }
        }
      }
      break;
    }
    case type_interpolate:
    {
      if(!value->interpolate.values || !value->interpolate.values->length)
      {
        string_buffer_append(display_buffer,(UChar*)to_unicode("$\"\""));
      }
      string_buffer_append(display_buffer,(UChar*)to_unicode("$\""));

      value_t *current;
      iterator_t *items = get_iterator(value->interpolate.values);

      for(current = iterate_first(items);
          iterate_is_valid(items);
          current = iterate_next(items))
      {
        if(has_type(current,type_name))
        {
          string_buffer_append_character(display_buffer,'{');
          display_value(display_buffer,current);
          string_buffer_append_character(display_buffer,'}');
        }
        else
        {
          string_buffer_append(display_buffer,current->string.value);
        }
      }
      string_buffer_append_character(display_buffer,'"');
      break;
    }
    default:
      assert(0);
  }
}

UChar *show_value(value_t *value)
{
  const size_t buffer_size = 256;
  string_buffer_t *display_buffer = make_string_buffer(buffer_size);

  display_value(display_buffer, value);

  return string_buffer_finalize(display_buffer);
}

void show_exception(handler_t *handler)
{
  tag_t *tag = handler->tag;
  value_t *value = handler->value;
  UFILE *u_stderr = u_finit(stderr, NULL, NULL);
  if(handler->stack && handler->stack->length)
  {
    // Show backtrace - horrid lack of abstraction :(
    int depth = 1;
    while(handler->stack->length)
    {
      UChar *unknown = to_unicode("<unknown>");
      call_t *call = pop_call_stack(handler);
      u_fprintf(u_stderr,
        "#%d %S", depth++,
        show_top_level_call((value_t*)call));
      u_fprintf(u_stderr,
        " | %S:%u\n",
        call->filename ? call->filename : unknown,
        call->line_number);
    }
  }
  u_fprintf(u_stderr,
      "Uncaught exception '%S': %S\n",
      show_value((value_t*)tag),
      show_value(value));
  u_fclose(u_stderr);
}

int interpret(function_t*main,int argc, char **argv)
{
  int i;
  handler_t handler;
  handler.stack = make_generic_list(NULL);
  handler.status = setjmp(handler.jump);
  if(handler.status)
  {
    show_exception(&handler);
    return -1;
  }

  generic_list_t *arguments = make_generic_list(NULL);
  for(i = 0; i < argc; i++)
  {
    string_t *value = make_string(to_unicode(argv[i]));
    generic_list_add(arguments,value);
  }
  // Call into main with list as args
  scope_t *builtins = construct_builtins();
  closure_t *closure = make_closure(builtins, main);
  list_t *argument_list = make_list(arguments);
  value_t *result = call_closure(closure,make_generic_list(argument_list),0,NULL, &handler);
  // Make **env available too?
  return 0;
}

void repl(char *program_name);

int main(int argc, char **argv)
{
  GC_INIT();
  init_symbols();

  handler_t handler;
  handler.stack = make_generic_list(NULL);
  handler.status = setjmp(handler.jump);
  if(handler.status)
  {
    show_exception(&handler);
    return -1;
  }

  if(argc > 1)
  {
    UFILE *filehandle = u_fopen(argv[1],"r",NULL,NULL);
    function_t *main;
    main = parse(filehandle,to_unicode(argv[1]),&handler);
    interpret(main,argc-1,++argv);
    return 0;
  }  
  
  repl(*argv);
  return 0;
}
